        TITL DAI FIRMWARE DEB8-0E015  V1.1
        ORG   :DEB8
*
*
*
*  ===================================
*** BASIC EXECUTION / RUN-TIME MODULE ***
*  ===================================
*
* Generally, BC is used as entry pointer to the
* textbuffer.
*
********************
* RUN basiccmd NEW *
********************
*
* Sets up heap, empty textbuffer and symboltable,
* sets pointers of textbuffer and symboltable
* correctly. Old buffer contents is not destroyed,
* (except 4 locations), but not useable.
* Valid as direct command only.
*
* Exit: A=1, CY=1.
*
RNEW    LHLD  :029B     Get startaddr heap
        SHLD  :029F     Set start textbuf=start heap
        MVI   M,:00     Store 00 in 1st addr.
        INX   H
        SHLD  :02A1     Set start symtab
        MVI   M,:00     00 in 1st addr.
        INX   H
        SHLD  :02A3     Set end symtab
 REM
* Entry from scratch/edit:
 REM
HRINIT  LHLD  :029D     Get heap size
        XCHG            in DE
        CALL  :D195     Init heap to all available
        MVI   A,:01     Code for 'buffer crunched'
        STC
        RET
*
*********************
* RUN basiccmd CONT *
*********************
*
* Resets step flag, decr. CONFL (error if it was
* 0), restores FRAME from stack, restores stack-
* pointer and continues program execution.
* Valid as direct command only.
*
RCONT   XRA   A
RCN10   STA   :0116     Reset step flag
        LXI   H,:0126   Get pntr suspended program
        DCR   M         Update it
        MVI   A,:19
        JM    :D9F5     Evt. run error 'CAN'T CONT'
        LHLD  :0127     Get current base stack level
        XCHG            in DE
        LXI   H,:0015   FRAME length
        DAD   D         Top of FRAME in stack
        PUSH  H         Save it
        LXI   B,:0100   Addr SYSBOT
        CALL  :DE4F     Load FRAME from stack
        POP   H         Get addr FRAME top in stack
        SHLD  :0127     Update current base stack
 REM level
        SPHL            Update stackpointer
        LHLD  :0102     Get start current command
        MOV   B,H
        MOV   C,L       Store it in BC
        JMP   :C87F     Run BASIC line
*
*********************
* RUN basiccmd STEP *
*********************
*
RSTEP   MVI   A,:FF     Init value STEP flag
        JMP   :DED6     Set STEP flag and continu
*
*********************
* RUN basiccmd STOP *
*********************
*
* Entry: No conditions.
* Exit:  A=03, CY=1. HL points after string.
*
RSTOP   CALL  :D7E6     Print 'STOPPED'
        DBL   :DBC9
        MVI   A,:03     Code for 'susp. execution'
        STC
        RET
*
********************
* RUN basiccmd END *
********************
*
* Entry: No conditions.
* Exit:  A=01, CY=1. HL points after string.
*
REND    CALL  :D7E6     Print 'END PROGRAM'
        DBL   :DBCF
        MVI   A,:01     Code for 'stop execution'
        STC
        RET
*
*******************
* RUN basiccmd IF *
*******************
*
* Used for IF .. GOTO <linenr> and for
* IF .. THEN <linenr>.
*
*RIFG
RIFTL   CALL  :E763     (0) Run logical expression
        INR   A
        JZ    :DF63     Run GOTO if condition true
 REM
* If condition false:
 REM
        INX   B
        INX   B         Skip linenr
        ORA   A         No special action
        RET
*
***************************************
* RUN basiccmd IF .. THEN <statement> *
***************************************
*
RIFTC   CALL  :E763     (0) Run logical expression
        INR   A
        JNZ   :E18F     (0) Ignore rest if false
 REM
* If condition true:
 REM
        INX   B         Skip length line
        ORA   A         No special action
        RET             Execute rest of line
*
******************
* basiccmd GOSUB *
******************
*
* Saves current program state on the interpreter
* stack and branches to a named line. The running
* FOR loop (if any) is saved in order to avoid
* problems if any unpaired NEXT is encountered.
* The stackpointer at the subroutine-entry is held
* to enable breaking out of a FOR-NEXT loop.
*
RGOSUB  CALL  :E6ED     (0) Get linenr and find it
 REM
* Entry from ON - GOSUB:
 REM
RGS10   POP   D         Kill return addr
        SHLD  :0119     Save new PC
        CALL  :E13C     (0) Save FOR loop contents
        PUSH  B         Save program position
        LHLD  :0119     Get new PC
        MOV   B,H       ) Is new text position
        MOV   C,L       )
        LHLD  :0113     Get stack level last GOSUB
        PUSH  H         Save evt link to previous
 REM subroutine entry
        LXI   H,:0000
        SHLD  :0104     No running loop
        DAD   SP        SP in HL
        SHLD  :0113     SP in STKGOS for return
 REM
* Entry on return:
 REM
RGS20   ORA   A         No special action
        JMP   :C88F     Into Basic monitor
*
***********************
* RUN basiccmd RETURN *
***********************
*
* Reverses the effect of a previous 'GOSUB'.
*
RRET    POP   D         Kill returnaddr
        LHLD  :0113     Get stack level last GOSUB
        MOV   A,H
        ORA   L         0 if no active call
        MVI   A,:01
        JZ    :D9F5     Then run error 'RETURN
 REM WITHOUT GOSUB'
        SPHL            Else: re-instate old stack
        POP   H
        SHLD  :0113     Link back to previous
 REM GOSUB
        POP   B         Restore text pntr
        CALL  :E167     (0) Pop FRAME
        JMP   :DF48     Back to Basic monitor
*
*********************
* RUN basiccmd GOTO *
*********************
*
* Simply transfers control to a named line.
*
* Entry from IF - GOTO:
*
RGOTO   CALL  :E6ED     (0) Get linenr and find it
 REM
* Entry from ON - GOTO:
 REM
RGT10   MOV   B,H       ) Set textpointer to line
        MOV   C,L       )
        ORA   A         No special action
        RET
*
***************************
* RUN basiccmd ON .. GOTO *
***************************
*
RONGT   CALL  :DF78     Process command
        JC    :DF66     Use GOTO if OK
        RET             If outside list
*
****************************
* RUN basiccmd ON .. GOSUB *
****************************
*
RONGS   CALL  :DF78     Process command
        JC    :DF2D     Use GOSUB if OK
        RET             If outside list
*
***********************
* COMMON 'ON ..' CODE *
***********************
*
* Exit: CY=1: OK.
*       CY=0: Outside list.
*
RONFN   CALL  :E71D     ) (0) Get index of number
        MOV   E,A       ) in list in E
        LDAX  B         Get nr of linenrs in list
        INX   B
        MOV   L,A
        MVI   H,:00
        DAD   H
        DAD   B         Pointer after list
        PUSH  H         Save pointer
        DCR   E
        INR   E
        JZ    :DF9B     Index of 0: outside list
        CMP   E
        JC    :DF9B     If index too large
        MVI   D,:00
        DCX   D
        XCHG
        DAD   H
        DAD   B         Pntr to reqd linenr
        MOV   B,H       ) in BC
        MOV   C,L       )
        CALL  :E6ED     (0) Find reqd line
        POP   B
        STC             CY=1: OK
        RET
 REM
* If outside list:
 REM
ROF10   POP   B
ROF11   ORA   A         CY=0: outside list
        RET
*
********************
* RUN basiccmd RUN *
********************
*
* No linenumber is given.
*
*
***********
* RUN RUN *
***********
*
* The sequence of the instructions is modified.
* This enables RUN <linenr> to be used without
* destroying the contents of heap and symtab.
*
RRUN    CALL  :CB23     Empty heap and symtab
        LHLD  :029F     Get start textbuf
        MOV   B,H       ) in BC
        MOV   C,L       )
        CALL  :E401     Run RESTORE
        LXI   H,:0000
        SHLD  :0115     Reset step/trace flag
        XRA   A
        STA   :0126     No suspended program
        LXI   SP,:F900  Reset SP
        ORA   A         No special action
        JMP   :C88F     Run program
*
*****************************
* RUN basiccmd RUN <linenr> *
*****************************
*
* After RUN, a line number is given.
*
RRUNN   CALL  :E6ED     (0) Read linenr and find
 REM it in textbuf
 REM
* RUN <linenr> :
 REM
        JMP   :DFA4     ! Process RUN
*
*********************
* RUN basiccmd POKE *
*********************
*
RPOKE   CALL  :E6F8     (0) Get addr in HL
 REM
* Entry for other modules:
 REM
RPEN    CALL  :E71D     (0) Get argument in A
        MOV   M,A       Store it
        ORA   A         No special action
        RET
*
********************
* RUN basiccmd OUT *
********************
*
ROUT    CALL  :E71D     (0) Get portnr in A
        MOV   D,A       and in D
        CALL  :E71D     (0) Get data in A
        MOV   E,A       and in E
        ORA   A
        JMP   :D8C8     Output to DCE-bus
*
*********************
* RUN basiccmd WAIT *
*********************
*
* WAIT I,J,K reads the status of Real World port
* I, EXOR's it with K and AND's it with J until
* a result equal to J is obtained.
*
RWAIT   CALL  :E71D     (0) Get portnr
        MOV   D,A       in D
        CALL  :E71D     (0) Get bits needed high
        MOV   H,A       in H
        LDAX  B         Get next byte from text
        INX   B
        SUI   :FF       Check if only 2 arguments
        NOP
        CNZ   :CEDA     If 3 arg: Get XOR mask
        MOV   L,A       in L
RWT20   CALL  :D8E0     Input from DCE-bus
        MOV   A,E       into A
        XRA   L         XOR with mask
        ANA   H         AND with bits needed high
        CMP   H         Correct value reached?
        RZ              Then abort
        CALL  :D6A5     Check keyb for new inputs
        JNC   :DFE6     Next DCE-input if no Break
 REM
* If suspended:
 REM
        JMP   :E012     (0) Quit: 'cmd broken in'
*
*************************
* RUN basiccmd WAIT MEM *
*************************
*
* As WAIT, but with I is a memory location.
*
RWTEM   CALL  :E6F8     (0) Get memory addr in HL
        CALL  :E71D     (0) Get bit mask
        MOV   D,A       in D
        LDAX  B         Get next byte from text
        INX   B
        SUI   :FF       Check if only 2 arguments
        NOP
        CNZ   :CEDA     If 3 arg: Get XOR mask
        MOV   E,A       in E
RWM20   MOV   A,E       XOR mask in A
        XRA   M         XOR with memory
        ANA   D         AND with bit mask
        CMP   D         Correct value reached?
        RZ              Then abort
        CALL  :D6A5     Check keyb for inputs
        JNC   :E007     Cont if no Break pressed
 REM
* If suspended:
 REM
RWT30   MVI   A,:02     Code 'command broken in'
        STC
        RET
*
*
*
        UNL
RIFG    EQU RIFTL
        LST
        END
